home *** CD-ROM | disk | FTP | other *** search
/ Softdisk Supreme / Softdisk Supreme.iso / pc / DSK Files / 0-49 / SD005b.dsk / KALEIDOSCOPE.bas < prev    next >
BASIC Source File  |  2003-06-12  |  7KB  |  174 lines
  1. 1 PL =  PEEK(103):PH =  PEEK(104)
  2. 2  GOSUB 5000
  3. 3  DEF  FN M4(X) =  INT(X) - INT(X/40) *40
  4. 4  DEF  FN M3(X) =  INT(X) - INT(X/33) *33
  5. 5  DEF  FN M7(X) =  INT(X) - INT(X/37) *37
  6. 6  DEF  FN AD(X) =  PEEK(121) +256 * PEEK(122) +1
  7. 7  DEF  FN R(X) =  INT( RND(1) *X)
  8. 8  DEF  FN M2(X) =  INT(X) - INT(X/21) *21
  9. 9 KBD =  -16384:CLR =  -16368
  10. 10  ONERR  GOTO 6000
  11. 11  TEXT : CALL  -936
  12. 20  PRINT "   *** KALEIDOSCOPES ***"
  13. 30  PRINT : PRINT : PRINT 
  14. 40  PRINT "WHICH ONE ?": PRINT 
  15. 45  PRINT 
  16. 50  PRINT "1- SINGLE <COL=FN(ROW)>"
  17. 55  PRINT 
  18. 60  PRINT "2- DOUBLE <ROW,COL=FN(I,J)>"
  19. 65  PRINT 
  20. 70  PRINT "3- TRIPLE <ROW,COL=FN(I,J,K)>"
  21. 75  PRINT 
  22. 80  PRINT "4- SPLITS (SNOWFLAKES)"
  23. 85  PRINT 
  24. 90  PRINT "5- LEAVES (THREE FOLD)"
  25. 95  PRINT 
  26. 100  PRINT "0- END PROGRAM"
  27. 105  PRINT 
  28. 110  PRINT "==> ";: GET N$: PRINT N$:N =  ASC(N$) -48
  29. 120  IF N = 0  THEN  END 
  30. 130  IF N <1  OR N >5  THEN 10
  31. 135  CALL  -936
  32. 140  ON N GOTO 1000,1200,1400,1600,1800
  33. 1000 AD =  FN AD(0): POKE 103,AD - INT(AD/256) *256: POKE 104, INT(AD/256)
  34. 1005 NUM = NUM +1: IF NUM >5  THEN NUM = 1
  35. 1010  GR : COLOR=  FN R(15)
  36. 1015  FOR I = 0 TO 3000
  37. 1020  FOR ROW = 0 TO 39
  38. 1025  ON NUM GOTO 1030,1040,1050,1060,1070
  39. 1030 COL = (ROW +I)/3 *5:COL =  FN M4(COL)
  40. 1035  GOTO 1075
  41. 1040 COL =  ABS(I -ROW *2):COL =  FN M4(COL)
  42. 1045  GOTO 1075
  43. 1050 COL =  ABS(ROW - ABS(I -ROW)/3 *4):COL =  FN M3(COL)
  44. 1055  GOTO 1075
  45. 1060 COL =  ABS(I -ROW *ROW):COL =  FN M4(COL)
  46. 1065  GOTO 1075
  47. 1070 COL = (ROW *I):COL =  FN M4(COL)
  48. 1075  PLOT ROW,COL: PLOT COL,ROW: PLOT 39 -ROW,COL: PLOT 39 -COL,ROW
  49. 1080  PLOT ROW,39 -COL: PLOT COL,39 -ROW: PLOT 39 -ROW,39 -COL: PLOT 39 -COL,39 -ROW
  50. 1085 X =  PEEK(KBD): IF X = 160  THEN  POKE CLR,0: GOTO 1005
  51. 1090  IF X > = 128  THEN  GOSUB 2000
  52. 1095  IF ( FN R( PDL(0) +2) <10)  THEN  GOSUB 3000
  53. 1100  NEXT ROW
  54. 1105  NEXT I
  55. 1110  GOTO 1015
  56. 1200  POKE 202, PEEK(220): POKE 203, PEEK(221)
  57. 1205  GR : COLOR=  FN R(15) +1:NUM = NUM +1: IF NUM >5  THEN NUM = 1
  58. 1210 :
  59. 1215  FOR I = 0 TO 3000
  60. 1220  FOR J = 0 TO 19
  61. 1225  ON NUM GOTO 1230,1240,1250,1260,1270
  62. 1230 COL = (I +20 *J *J)/3 *4:ROW = (I +29 *J *J)/3 *5:COL =  FN M3(COL):ROW =  FN M7(ROW)
  63. 1235  GOTO 1275
  64. 1240 COL = (I/(J +1) +3 *J):ROW = (I/(J *J +1) +3 *J):COL =  FN M4(COL):ROW =  FN M4(ROW)
  65. 1245  GOTO 1275
  66. 1250 COL =  ABS(I -J):ROW = (I *J):COL =  FN M4(COL):ROW =  FN M4(ROW)
  67. 1255  GOTO 1275
  68. 1260 COL =  ABS(I -J):ROW =  ABS(J - ABS(I -J)):COL =  FN M4(COL):ROW =  FN M3(ROW)
  69. 1265  GOTO 1275
  70. 1270 COL =  ABS(I -J):ROW =  ABS(I -J *J):COL =  FN M4(COL):ROW =  FN M4(ROW)
  71. 1275  PLOT ROW,COL: PLOT COL,ROW: PLOT 39 -ROW,COL: PLOT 39 -COL,ROW
  72. 1280  PLOT ROW,39 -COL: PLOT COL,39 -ROW: PLOT 39 -ROW,39 -COL: PLOT 39 -COL,39 -ROW
  73. 1285 X =  PEEK(KBD): IF X = 160  THEN  POKE CLR,0: GOTO 1205
  74. 1290  IF X > = 128  THEN  GOSUB 2000
  75. 1295  IF ( FN R( PDL(0) +2) <10)  THEN  GOSUB 3000
  76. 1300  NEXT J
  77. 1305  NEXT I
  78. 1310  GOTO 1215
  79. 1400 AD =  FN AD(0): POKE 103,AD - INT(AD/256) *256: POKE 104, INT(AD/256)
  80. 1405 NUM = NUM +1: IF NUM >5  THEN NUM = 1
  81. 1410  GR : COLOR=  FN R(15) +1
  82. 1415  FOR I = 0 TO 3000
  83. 1420  FOR J = 0 TO 39
  84. 1425  FOR K = 19 TO 0  STEP  -1
  85. 1430  ON NUM GOTO 1435,1445,1455,1465,1475
  86. 1435 ROW =  ABS(I - ABS(J - ABS(K -J))):COL = (ROW +I +J +K)/3 *5:ROW =  FN M2(ROW):COL =  FN M3(COL)
  87. 1440  GOTO 1480
  88. 1445 ROW =  ABS(I - ABS(J - ABS(K -J))):COL =  ABS(I -J -K *3)/3 *5:ROW =  FN M2(ROW):COL =  FN M3(COL)
  89. 1450  GOTO 1480
  90. 1455 ROW =  ABS(I - ABS(J - ABS(K -J))):COL =  ABS(ROW +I -J *J -K)/3 *5:ROW =  FN M2(ROW):COL =  FN M3(COL)
  91. 1460  GOTO 1480
  92. 1465 ROW =  ABS(I - ABS(J - ABS(K -J))):COL =  ABS(I -J *J +K *K)/3 *5:ROW =  FN M2(ROW):COL =  FN M3(COL)
  93. 1470  GOTO 1480
  94. 1475 ROW =  ABS(I - ABS(J - ABS(K -J))):COL =  ABS(I -ROW *ROW -J *J +K *K)/3 *7:ROW =  FN M2(ROW):COL =  FN M3(COL)
  95. 1480  PLOT ROW,COL: PLOT COL,ROW: PLOT 39 -ROW,COL: PLOT 39 -COL,ROW
  96. 1485  PLOT ROW,39 -COL: PLOT COL,39 -ROW: PLOT 39 -ROW,39 -COL: PLOT 39 -COL,39 -ROW
  97. 1490 X =  PEEK(KBD): IF X = 160  THEN  POKE CLR,0: GOTO 1405
  98. 1495  IF X > = 128  THEN  GOSUB 2000
  99. 1500  IF ( FN R( PDL(0) +2) <10)  THEN  GOSUB 3000
  100. 1505  NEXT J
  101. 1510  NEXT I
  102. 1515  GOTO 1415
  103. 1600 AD =  FN AD(0): POKE 103,AD - INT(AD/256) *256: POKE 104, INT(AD/256)
  104. 1605  GR : COLOR=  FN R(15) +1
  105. 1610  FOR I = 1 TO 32000
  106. 1615 SPLIT = 5 +(I - INT(I/5) *5) *(I - INT(I/3) *3)
  107. 1620  FOR J = 0 TO SPLIT
  108. 1625 RT =  ABS(I - ABS(J -I)):ROW = RT - INT(RT/10) *10 + ABS(SPLIT - ABS(J -SPLIT))
  109. 1630  GOSUB 1685
  110. 1635  NEXT J
  111. 1640  FOR J = SPLIT +1 TO 19
  112. 1645 ROW =  FN M3( FN M2( ABS(SPLIT - ABS(I -SPLIT))) +SPLIT - FN M2( ABS(I - ABS(J -I))) +SPLIT)
  113. 1650  GOSUB 1685
  114. 1655  NEXT J
  115. 1660  IF (I - INT(I/8) *8) < >0  THEN 1680
  116. 1665  FOR DE = 1 TO 500: NEXT DE
  117. 1670  GOSUB 1705
  118. 1675  IF  FN R(2)  THEN  GR : COLOR=  FN R(15) +1
  119. 1680  NEXT I
  120. 1685  PLOT ROW,J: PLOT 39 -ROW,J
  121. 1690  PLOT ROW,39 -J: PLOT 39 -ROW,39 -J
  122. 1695  PLOT J,ROW: PLOT J,39 -ROW
  123. 1700  PLOT 39 -J,ROW: PLOT 39 -J,39 -ROW
  124. 1705 X =  PEEK(KBD): IF X > = 128  THEN  GOSUB 2000
  125. 1710  IF ( FN R( PDL(0) +2) <10)  THEN  GOSUB 3000
  126. 1715  RETURN 
  127. 1800 AD =  FN AD(0): POKE 103,AD - INT(AD/256) *256: POKE 104, INT(AD/256)
  128. 1805  GR : COLOR=  FN R(15) +1
  129. 1810  FOR I = 500 TO 32767
  130. 1815  IF (I - INT(I/2) *2)  THEN 1830
  131. 1820  FOR J = 17 TO 0  STEP  -1
  132. 1825  GOTO 1835
  133. 1830  FOR J = 0 TO 17
  134. 1835  IF (I - INT(I/2) *2)  THEN 1845
  135. 1840 ROW =  FN M4( FN M4(I) * FN M4( ABS(40 -I))): GOTO 1860
  136. 1845  IF (I - INT(I/3) *3)  THEN 1855
  137. 1850 ROW = J +2 *I - INT(I/3) *3 - INT(I/5) *5: GOTO 1860
  138. 1855 ROW =  FN M3( FN M2(I *J) + FN M2(I +J))
  139. 1860  PLOT ROW,J: PLOT 39 -ROW,J
  140. 1865  PLOT ROW,39 -J: PLOT 39 -ROW,39 -J
  141. 1870  PLOT J,ROW: PLOT 39 -J,ROW
  142. 1875  PLOT J,39 -ROW: PLOT 39 -J,39 -ROW
  143. 1880 X =  PEEK(KBD): IF X > = 128  THEN  GOSUB 2000
  144. 1885  IF ( FN R( PDL(0) +2) <10)  THEN  GOSUB 3000
  145. 1890  NEXT J
  146. 1895  NEXT I
  147. 2000  POKE CLR,0: IF X = 141  THEN  GR : GOSUB 3000: RETURN 
  148. 2010  IF X =  ASC("Q") +128  THEN  POP : POKE 103,PL: POKE 104,PH: GOTO 10
  149. 2020  IF  PEEK(KBD) <128  THEN 2020
  150. 2030  POKE CLR,0
  151. 2040  RETURN 
  152. 3000 P1 =  FN R(8):P2 = 15 - FN R(8):R =  FN R(2)
  153. 3010  COLOR= R *P1 +(1 -R) *P2: RETURN 
  154. 5000  TEXT : CALL  -936: PRINT "   *** KALEIDOSCOPES ***"
  155. 5002  PRINT : PRINT 
  156. 5005  INPUT "DO YOU NEED INSTRUCTIONS? ";R$
  157. 5010  IF  LEFT$(R$,1) < >"Y"  THEN  RETURN 
  158. 5020  PRINT : PRINT " THERE ARE SEVERAL TYPES OF"
  159. 5030  PRINT "KALEIDOSCOPES IN THIS PROGRAM"
  160. 5035  PRINT : PRINT "THE OPTIONS ARE:": PRINT 
  161. 5040  PRINT "PRESS RETURN TO START THE DESIGN OVER."
  162. 5050  PRINT "PRESS 'Q' TO GET MENU."
  163. 5060  PRINT "PRESS ANY OTHER KEY TO STOP DISPLAY."
  164. 5065  PRINT 
  165. 5070  PRINT "EXCEPTION:": PRINT " DESIGNS #1-3 WILL CHANGE THEIR PATTERN  WHEN YOU PRESS THE SPACE BAR."
  166. 5075  PRINT : PRINT 
  167. 5100  PRINT "PRESS RETURN TO CONTINUE";
  168. 5110  INPUT R$: RETURN 
  169. 6000  REM  ERROR HANDLING ROUTINE
  170. 6010  POKE 103,PL: POKE 104,PH
  171. 6020  TEXT : HOME 
  172. 6030 ER =  PEEK(222):LN =  PEEK(219) *256 + PEEK(218)
  173. 6040  PRINT "STOPPED DUE TO:": PRINT "   ERROR # ";ER: PRINT "   AT LINE # ";LN
  174. 6050  END